home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Peter Lewis / PNL Libraries / QLowLevel.p < prev    next >
Encoding:
Text File  |  1994-09-18  |  5.5 KB  |  256 lines  |  [TEXT/PJMM]
  1. unit QLowLevel;
  2. (*}
  3. {# Copyright Department of Computer Science}
  4. {# University of Western Australia}
  5. {# Modified : Quinn}
  6. {# Station : Eriodon}
  7. {# Date : Monday, 4 November 1991}
  8. {}
  9. {Really sleasy stuff that it not for the faint of heart.}
  10. {}
  11. {*)
  12. interface
  13.  
  14. {$IFC undefined THINK_Pascal}
  15.     uses
  16.         Types;
  17. {$ENDC}
  18.  
  19. (* Global Bashing - Get constants from SysEqu.p *)
  20.     function GetGlobalB (ad: univ longint): SignedByte;
  21.     procedure SetGlobalB (ad: univ longint; b: SignedByte);    (* not univ cause}
  22. {I dont trust Pascal *)
  23.  
  24.     function GetGlobalW (ad: univ longint): integer;
  25.     procedure SetGlobalW (ad: univ longint; w: univ integer);
  26.  
  27.     function GetGlobalL (ad: univ longint): longint;
  28.     procedure SetGlobalL (ad: univ longint; l: univ longint);
  29.  
  30.     function GetGlobalS (ad: univ longint): Str255;
  31.     procedure SetGlobalS (ad: univ longint; s: Str255); (* only bashes len+1 chars *)
  32.  
  33. (* Calling *)
  34.     procedure CallProcPtr (ad: univ ProcPtr);
  35.     inline
  36.         $205F, (* move.l    (a7)+,a0        ; pop proc address    *)
  37.         $4E90; (* jsr            (a0)                ; call proc                    *)
  38.  
  39. (* Pointer Arithmetic *)
  40.     function AddPtrLong (p: univ Ptr; offset: longint): Ptr;
  41.     inline
  42.         $201F,    (* move.l    (sp)+,d0    ; pop offset *)
  43.         $D09F,    (* add.l    (sp)+,d0    ; add ptr to offset (and pop p) *)
  44.         $2E80;    (* move.l    d0,(sp)        ; place in result *)
  45.  
  46.     procedure OffsetPtr (var p: univ Ptr; offset: longint);
  47.     inline
  48.         $201F,    (* move.l    (sp)+,d0    ; pop offset *)
  49.         $205F,    (* move.l    (sp)+,a0    ; pop address of p *)
  50.         $D190;    (* add.l    d0,(a0)        ; add offset to p *)
  51.  
  52.     function SubPtrPtr (leftp, rightp: univ Ptr): longint;
  53.     inline
  54.         $201F,    (* move.l    (sp)+,d0    ; pop rightp *)
  55.         $A055,    (* _StripAddress        ; strip if needed *)
  56.         $2200,    (* move.l    d0,d1            ; store in d1 *)
  57.         $201F,    (* move.l    (sp)+,d0    ; pop leftp *)
  58.         $A055,    (* _StripAddress        ; strip if needed (reg traps preserve d1) *)
  59.         $9081,    (* sub.l    d1,d0            ; d0 := leftp - rightp *)
  60.         $2E80;    (* move.l    d0,(sp)        ; place result *)
  61.  
  62. (* unsigned comparisons *)
  63.  
  64.     function CompLS (a1, a2: univ longInt): boolean;
  65.     inline
  66.         $BF8F, $53C0, $4257, $4400, $1E80;
  67.  
  68.     function CompLO (a1, a2: univ longInt): boolean;
  69.     inline
  70.         $BF8F, $55C0, $4257, $4400, $1E80;
  71.  
  72.     function CompHS (a1, a2: univ longInt): boolean;
  73.     inline
  74.         $BF8F, $54C0, $4257, $4400, $1E80;
  75.  
  76.     function CompHI (a1, a2: univ longInt): boolean;
  77.     inline
  78.         $BF8F, $52C0, $4257, $4400, $1E80;
  79.  
  80. (* Register Getting - Address *)
  81.  
  82.     function GetRegA0: Ptr;
  83.     inline
  84.         $2E88; (* movea.l    a0,(sp)        ; fetch a0 into tos    *)
  85.     function GetRegA1: Ptr;
  86.     inline
  87.         $2E89;
  88.     function GetRegA2: Ptr;
  89.     inline
  90.         $2E8A;
  91.     function GetRegA3: Ptr;
  92.     inline
  93.         $2E8B;
  94.     function GetRegA4: Ptr;
  95.     inline
  96.         $2E8C;
  97.     function GetRegA5: Ptr;
  98.     inline
  99.         $2E8D;
  100. {$IFC not undefined THINK_Pascal}
  101.     function GetRegA6: Ptr;
  102.     inline
  103.         $2E8E;
  104. {$ENDC}
  105.     function GetRegA7: Ptr;
  106.     inline
  107.         $2E8F;
  108.  
  109. (* Register Setting - Address *)
  110.  
  111.     procedure SetRegA0 (n: univ Ptr);
  112.     inline
  113.         $205F; (* movea.l    (sp)+,a0        ; pop n into a0    *)
  114.     procedure SetRegA1 (n: univ Ptr);
  115.     inline
  116.         $225F;
  117.     procedure SetRegA2 (n: univ Ptr);
  118.     inline
  119.         $245F;
  120.     procedure SetRegA3 (n: univ Ptr);
  121.     inline
  122.         $265F;
  123.     procedure SetRegA4 (n: univ Ptr);
  124.     inline
  125.         $285F;
  126.     procedure SetRegA5 (n: univ Ptr);
  127.     inline
  128.         $2A5F;
  129.     procedure SetRegA6 (n: univ Ptr);
  130.     inline
  131.         $2C5F;
  132.     procedure SetRegA7 (n: univ Ptr);
  133.     inline
  134.         $2E5F;
  135.  
  136. (* Register Getting - Data *)
  137.  
  138.     function GetRegD0: longint;
  139.     inline
  140.         $2E80; (* move.l    d0,(sp)        ; fetch d0 into tos    *)
  141.     function GetRegD1: longint;
  142.     inline
  143.         $2E81;
  144.     function GetRegD2: longint;
  145.     inline
  146.         $2E82;
  147.     function GetRegD3: longint;
  148.     inline
  149.         $2E83;
  150.     function GetRegD4: longint;
  151.     inline
  152.         $2E84;
  153.     function GetRegD5: longint;
  154.     inline
  155.         $2E85;
  156.     function GetRegD6: longint;
  157.     inline
  158.         $2E86;
  159.     function GetRegD7: longint;
  160.     inline
  161.         $2E87;
  162.  
  163. (* Register Setting - Data *)
  164.  
  165.     procedure SetRegD0 (n: univ longint);
  166.     inline
  167.         $201F; (* move.l    (sp)+,(d0)        ; pop n into d0    *)
  168.     procedure SetRegD1 (n: univ longint);
  169.     inline
  170.         $221F;
  171.     procedure SetRegD2 (n: univ longint);
  172.     inline
  173.         $241F;
  174.     procedure SetRegD3 (n: univ longint);
  175.     inline
  176.         $261F;
  177.     procedure SetRegD4 (n: univ longint);
  178.     inline
  179.         $281F;
  180.     procedure SetRegD5 (n: univ longint);
  181.     inline
  182.         $2A1F;
  183.     procedure SetRegD6 (n: univ longint);
  184.     inline
  185.         $2C1F;
  186.     procedure SetRegD7 (n: univ longint);
  187.     inline
  188.         $2E1F;
  189.  
  190.     procedure BSETW (var l: integer; num: integer);
  191.     inline
  192.         $301F, $205F, $3210, $01C1, $3081;
  193.  
  194.     procedure BCLRW (var l: integer; num: integer);
  195.     inline
  196.         $301F, $205F, $3210, $0181, $3081;
  197.  
  198. implementation
  199.  
  200. {$IFC undefined THINK_Pascal}
  201.     uses
  202.         Memory;
  203. {$ENDC}
  204.  
  205.     function GetGlobalB (ad: univ longint): SignedByte;
  206.     begin
  207.         GetGlobalB := Ptr(ad)^;
  208.     end; (* GetGlobalB *)
  209.  
  210.     procedure SetGlobalB (ad: univ longint; b: SignedByte);    (* not univ cause}
  211. {I dont trust Pascal *)
  212.     begin
  213.         Ptr(ad)^ := b;
  214.     end; (* GetGlobalB *)
  215.  
  216.     type
  217.         intPtr = ^integer;
  218.  
  219.     function GetGlobalW (ad: univ longint): integer;
  220.     begin
  221.         GetGlobalW := intPtr(ad)^;
  222.     end; (* GetGlobalB *)
  223.  
  224.     procedure SetGlobalW (ad: univ longint; w: univ integer);
  225.     begin
  226.         intPtr(ad)^ := w;
  227.     end; (* GetGlobalB *)
  228.  
  229.     type
  230.         longPtr = ^longint;
  231.  
  232.     function GetGlobalL (ad: univ longint): longint;
  233.     begin
  234.         GetGlobalL := longPtr(ad)^;
  235.     end; (* GetGlobalB *)
  236.  
  237.     procedure SetGlobalL (ad: univ longint; l: univ longint);
  238.     begin
  239.         longPtr(ad)^ := l;
  240.     end; (* GetGlobalB *)
  241.  
  242.     function GetGlobalS (ad: univ longint): Str255;
  243.         var
  244.             tmp: Str255;
  245.     begin
  246.         BlockMove(pointer(ad), @tmp, sizeof(tmp));
  247.         GetGlobalS := tmp;
  248.     end; (* GetGlobalB *)
  249.  
  250.     procedure SetGlobalS (ad: univ longint; s: Str255); (* only bashes}
  251. {len+1 chars *)
  252.     begin
  253.         BlockMove(@s, pointer(ad), Length(s) + 1);
  254.     end; (* GetGlobalB *)
  255.  
  256. end. (* LowLevel *)